home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / obero / oberon_lib.lha / oberon-a / source1.lha / source / ProgInOberon / RandomNumbers.mod
Text File  |  1994-08-08  |  1KB  |  64 lines
  1. (*
  2.      $RCSfile: RandomNumbers.mod $
  3.   Description: Random number generator from "Programming In Oberon"
  4.  
  5.    Created by: fjc (Frank Copeland)
  6.     $Revision: 1.4 $
  7.       $Author: fjc $
  8.         $Date: 1994/08/08 16:40:04 $
  9.  
  10.   Copyright © 1990-1993, ETH Zuerich
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14. *)
  15.  
  16. MODULE RandomNumbers;
  17.  
  18. (*
  19. ** $C= CaseChk       $I= IndexChk  $L+ LongAdr   $N= NilChk
  20. ** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  21. ** $V= OvflChk       $Z= ZeroVars
  22. *)
  23.  
  24. IMPORT Dos;
  25.  
  26. VAR z : LONGINT;
  27.  
  28. (*------------------------------------*)
  29. PROCEDURE Uniform * () : REAL;
  30.  
  31.   CONST a = 16807; m = 2147483647; q = m DIV a; r = m MOD a;
  32.  
  33.   VAR gamma : LONGINT;
  34.  
  35. BEGIN (* Uniform *)
  36.   gamma := a * (z MOD q) - r * (z DIV q);
  37.   IF gamma > 0 THEN z := gamma
  38.   ELSE z := gamma + m
  39.   END;
  40.   RETURN z * (1.0 / m)
  41. END Uniform;
  42.  
  43. (*------------------------------------*)
  44. PROCEDURE InitSeed * (seed : LONGINT);
  45.  
  46. BEGIN (* InitSeed *)
  47.   z := seed
  48. END InitSeed;
  49.  
  50. (*------------------------------------*)
  51. PROCEDURE TimeSeed * ();
  52.  
  53.   VAR ds : Dos.Date; x : REAL;
  54.  
  55. BEGIN (* TimeSeed *)
  56.   Dos.base.DateStamp (ds);
  57.   z := (ds.minute * (60 * Dos.ticksPerSecond)) + ds.tick;
  58.   x := Uniform()
  59. END TimeSeed;
  60.  
  61. BEGIN
  62.   z := 314159
  63. END RandomNumbers.
  64.